unit mapdrawerunit;
{< Parts of this modules are adapted from rpg_core/Tilemap.js from corescript,
MIT-licensed. }

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics, fpjson, fgl, database, tilesetgraphicsunit,
  BGRABitmapTypes, BGRABitmap, constants;

type
  TMapDrawer = class
    private
      TilesetGraphics: TTilesetGraphics;
    public
      Db: TDatabase;
      TileWidth: Integer;
      TileHeight: Integer;

      constructor Create;

      procedure SetTileset(AGfx: TTilesetGraphics; ADb: TDatabase);
      function DrawMap(Map: TJSONObject; ADstTileWidth, ADstTileHeight: Integer; TilesRect: TRect): TBGRABitmap;
  end;

  TIntegerList = specialize TFPGList<Integer>;

  TPartCoordinates = array [0..1] of Byte;
  TTileDescription = array [0..3] of TPartCoordinates;
  TAutotileTable = array [0..47] of TTileDescription;
  PAutotileTable = ^TAutotileTable;

const
  FLOOR_AUTOTILE_TABLE: array [0..47] of TTileDescription = (
    ((2,4),(1,4),(2,3),(1,3)),((2,0),(1,4),(2,3),(1,3)),
    ((2,4),(3,0),(2,3),(1,3)),((2,0),(3,0),(2,3),(1,3)),
    ((2,4),(1,4),(2,3),(3,1)),((2,0),(1,4),(2,3),(3,1)),
    ((2,4),(3,0),(2,3),(3,1)),((2,0),(3,0),(2,3),(3,1)),
    ((2,4),(1,4),(2,1),(1,3)),((2,0),(1,4),(2,1),(1,3)),
    ((2,4),(3,0),(2,1),(1,3)),((2,0),(3,0),(2,1),(1,3)),
    ((2,4),(1,4),(2,1),(3,1)),((2,0),(1,4),(2,1),(3,1)),
    ((2,4),(3,0),(2,1),(3,1)),((2,0),(3,0),(2,1),(3,1)),
    ((0,4),(1,4),(0,3),(1,3)),((0,4),(3,0),(0,3),(1,3)),
    ((0,4),(1,4),(0,3),(3,1)),((0,4),(3,0),(0,3),(3,1)),
    ((2,2),(1,2),(2,3),(1,3)),((2,2),(1,2),(2,3),(3,1)),
    ((2,2),(1,2),(2,1),(1,3)),((2,2),(1,2),(2,1),(3,1)),
    ((2,4),(3,4),(2,3),(3,3)),((2,4),(3,4),(2,1),(3,3)),
    ((2,0),(3,4),(2,3),(3,3)),((2,0),(3,4),(2,1),(3,3)),
    ((2,4),(1,4),(2,5),(1,5)),((2,0),(1,4),(2,5),(1,5)),
    ((2,4),(3,0),(2,5),(1,5)),((2,0),(3,0),(2,5),(1,5)),
    ((0,4),(3,4),(0,3),(3,3)),((2,2),(1,2),(2,5),(1,5)),
    ((0,2),(1,2),(0,3),(1,3)),((0,2),(1,2),(0,3),(3,1)),
    ((2,2),(3,2),(2,3),(3,3)),((2,2),(3,2),(2,1),(3,3)),
    ((2,4),(3,4),(2,5),(3,5)),((2,0),(3,4),(2,5),(3,5)),
    ((0,4),(1,4),(0,5),(1,5)),((0,4),(3,0),(0,5),(1,5)),
    ((0,2),(3,2),(0,3),(3,3)),((0,2),(1,2),(0,5),(1,5)),
    ((0,4),(3,4),(0,5),(3,5)),((2,2),(3,2),(2,5),(3,5)),
    ((0,2),(3,2),(0,5),(3,5)),((0,0),(1,0),(0,1),(1,1))
  );

  WALL_AUTOTILE_TABLE: array [0..15] of TTileDescription = (
      ((2,2),(1,2),(2,1),(1,1)),((0,2),(1,2),(0,1),(1,1)),
      ((2,0),(1,0),(2,1),(1,1)),((0,0),(1,0),(0,1),(1,1)),
      ((2,2),(3,2),(2,1),(3,1)),((0,2),(3,2),(0,1),(3,1)),
      ((2,0),(3,0),(2,1),(3,1)),((0,0),(3,0),(0,1),(3,1)),
      ((2,2),(1,2),(2,3),(1,3)),((0,2),(1,2),(0,3),(1,3)),
      ((2,0),(1,0),(2,3),(1,3)),((0,0),(1,0),(0,3),(1,3)),
      ((2,2),(3,2),(2,3),(3,3)),((0,2),(3,2),(0,3),(3,3)),
      ((2,0),(3,0),(2,3),(3,3)),((0,0),(3,0),(0,3),(3,3))
  );

  WATERFALL_AUTOTILE_TABLE: array [0..3] of TTileDescription = (
      ((2,0),(1,0),(2,1),(1,1)),((0,0),(1,0),(0,1),(1,1)),
      ((2,0),(3,0),(2,1),(3,1)),((0,0),(3,0),(0,1),(3,1))
  );

implementation

uses
  globals, Dialogs, math, autotilehelper;

constructor TMapDrawer.Create;
begin
  TileWidth := 48; //TODO
  TileHeight := 48;
end;

procedure TMapDrawer.SetTileset(AGfx: TTilesetGraphics; ADb: TDatabase);
begin
  TilesetGraphics := AGfx;
  Db := ADb;
end;

{ Draws the map data. Parts of this function are adapted from Kadokawa's
  corescript released under MIT license }
function TMapDrawer.DrawMap(Map: TJSONObject; ADstTileWidth, ADstTileHeight: Integer; TilesRect: TRect): TBGRABitmap;
var
  ResImg: TBGRABitmap;
  Data: TJSONArray;
  Flags: TJSONArray;
  MapWidth, MapHeight: Integer;
  UpperTiles, LowerTiles: TIntegerList;
  X1, Y1, X2, Y2: Integer;

  function ReadMapData(X, Y, Z: Integer): Integer; inline;
  begin
    if (X >= 0) and (X < MapWidth) and (Y >= 0) and (Y < MapHeight) then begin
      ReadMapData := Data.Integers[(Z * MapHeight + Y) * MapWidth + X];
    end
    else
      ReadMapData := 0;
  end;

  function IsHigherTile(TileId: Integer): Boolean; inline;
  begin
    IsHigherTile := (TileId < Flags.Count)
                 and (Flags[TileId].JSONType = jtNumber)
                 and ((Flags.Integers[TileId] and $10) <> 0);
  end;

  function IsTableTile(TileId: Integer): Boolean; inline;
  begin
    IsTableTile := IsTileA2(TileId)
                and (TileId < Flags.Count)
                and (Flags[TileId].JSONType = jtNumber)
                and ((Flags.Integers[TileId] and $80) <> 0);
  end;

  procedure AddTileToList(TileId: Integer); inline;
  begin
    if IsHigherTile(TileId) then
      UpperTiles.Add(TileId)
    else
      LowerTiles.Add(TileId);
  end;

  procedure DrawShadow(ShadowBits, OffsetX, OffsetY: Integer); inline;
  begin
    //TODO
  end;

  { When A2 tile is marked as a table, its bottom part overlaps the tile
    with Y+1. This procedure draws this bottom part. }
  procedure DrawTableEdge(TileId, OffsetX, OffsetY: Integer); inline;
  var
    Kind, Shape, TilesetX, TilesetY, TileX, TileY: Integer;
    Desc: TTileDescription;
    SrcHalfWidth, SrcHalfHeight, DstHalfWidth, DstHalfHeight: Integer;
    I: Integer;
    PartX, PartY, SrcX, SrcY, DestX, DestY: Integer;
  begin
    if not TilesetGraphics.HasSet(tgstA2) or not IsTileA2(TileId) then
      Exit;

    Kind := GetAutotileKind(TileId);
    Shape := GetAutotileShape(TileId);
    TilesetX := Kind mod 8;
    TilesetY := Kind div 8;
    TileX := TilesetX * 2;
    TileY := (TilesetY - 2) * 3;

    if (Shape >= Low(FLOOR_AUTOTILE_TABLE))
          and (Shape < High(FLOOR_AUTOTILE_TABLE)) then begin
      Desc := FLOOR_AUTOTILE_TABLE[Shape];
      SrcHalfWidth := 24; //TODO: allow different sizes
      SrcHalfHeight := 24;
      DstHalfWidth := ADstTileWidth div 2;
      DstHalfHeight := ADstTileHeight div 2;

      for I := 0 to 1 do begin
        PartX := Desc[2 + I][0];
        PartY := Desc[2 + I][1];
        SrcX := (TileX * 2 + PartX) * SrcHalfWidth;
        SrcY := (TileY * 2 + PartY) * SrcHalfHeight + (SrcHalfHeight div 2);
        DestX := OffsetX + I * DstHalfWidth;
        DestY := OffsetY;
        ResImg.CanvasBGRA.CopyRect(
          Rect(DestX, DestY, DestX+DstHalfWidth, DestY + DstHalfHeight div 2),
          TilesetGraphics.Bitmaps[Integer(tgstA2)],
          Rect(SrcX, SrcY, SrcX + SrcHalfWidth, SrcY + SrcHalfHeight div 2)
        );
      end;
    end;
  end;

  procedure DrawAutotile(TileId, OffsetX, OffsetY: Integer);
  var
    AutotileTable: PAutotileTable;
    Kind, Shape, TX, TY, BX, BY, SetNumber, TableMax: Integer;
    IsTable: Boolean;

    procedure DrawByTileDescription(var Table: TTileDescription); inline;
    var
      SrcHalfWidth, SrcHalfHeight, DstHalfWidth, DstHalfHeight, I: Integer;
      QSX, QSY, SX1, SY1, DX1, DY1: Integer; //TODO: use better names
      QSX2, QSY2, SX2, SY2: Integer;
    begin
      SrcHalfWidth := 24;//TileWidth div 2;
      SrcHalfHeight := 24;// TileHeight div 2;
      DstHalfWidth := ADstTileWidth div 2;
      DstHalfHeight := ADstTileHeight div 2;
      for I := 0 to 3 do begin
        QSX := Table[I][0];
        QSY := Table[I][1];
        SX1 := (BX * 2 + QSX) * SrcHalfWidth;
        SY1 := (BY * 2 + QSY) * SrcHalfHeight;
        DX1 := OffsetX + (I mod 2) * DstHalfWidth;
        DY1 := OffsetY + (I div 2) * DstHalfHeight;

        if IsTable and ((QSY = 1) or (QSY = 5)) then begin
          { If A2 autotiles are marked as table autotiles, they are bigger than
            other tiles: their bottom part ends 1/4 tile lower than other tiles.
            This code handles the part BEFORE the bottom edge.. The bottom part
            is drawn by DrawTableEdge procedure.}
          QSX2 := QSX;
          QSY2 := 3;
          if QSY = 1 then begin
            case QSX of
              1: QSX2 := 3;
              3: QSX2 := 1;
            end;
          end;
          SX2 := (BX * 2 + QSX2) * SrcHalfWidth;
          SY2 := (BY * 2 + QSY2) * SrcHalfHeight;
          ResImg.CanvasBGRA.CopyRect(
            Rect(DX1, DY1, DX1 + DstHalfWidth, DY1 + DstHalfHeight),
            TilesetGraphics.Bitmaps[SetNumber],
            Rect(SX2, SY2, SX2 + SrcHalfWidth, SY2 + SrcHalfHeight)
          );
          DY1 := DY1 + DstHalfHeight div 2;
          ResImg.CanvasBGRA.CopyRect(
            Rect(DX1, DY1, DX1 + DstHalfWidth, DY1 + DstHalfHeight),
            TilesetGraphics.Bitmaps[SetNumber],
            Rect(SX1, SY1, SX1 + SrcHalfWidth, SY1 + SrcHalfHeight)
          )
        end
        else begin
          ResImg.CanvasBGRA.CopyRect(
            Rect(DX1, DY1, DX1 + DstHalfWidth, DY1 + DstHalfHeight),
            TilesetGraphics.Bitmaps[SetNumber],
            Rect(SX1, SY1, SX1 + SrcHalfWidth, SY1 + SrcHalfHeight)
          );
        end;
      end;
    end;

  begin
    AutotileTable := @FLOOR_AUTOTILE_TABLE;
    TableMax := High(FLOOR_AUTOTILE_TABLE);
    Kind := GetAutotileKind(TileId);
    Shape := GetAutotileShape(TileId);
    TX := Kind mod 8;
    TY := Kind div 8;
    BX := 0;
    BY := 0;
    SetNumber := 0;
    IsTable := False;

    if IsTileA1(TileId) then begin
      SetNumber := 0;
      BX := 0;
      if Kind = 0 then
        BY := 0
      else if Kind = 1 then
        BY := 3
      else if Kind = 2 then begin
        BX := 6;
        BY := 0
      end
      else if Kind = 3 then begin
        BX := 6;
        BY := 3
      end
      else begin
        BX := (TX div 4) * 8;
        BY := TY * 6 + ((TX div 2) mod 2) * 3;
        if Kind mod 2 <> 0 then begin
          Inc(BX, 6);
          AutotileTable := @WATERFALL_AUTOTILE_TABLE;
          TableMax := High(WATERFALL_AUTOTILE_TABLE)
        end;
      end;
    end
    else if IsTileA2(TileId) then begin
      SetNumber := 1;
      BX := TX * 2;
      BY := (TY - 2) * 3;
      IsTable := IsTableTile(TileId);
    end
    else if IsTileA3(TileId) then begin
      SetNumber := 2;
      BX := TX * 2;
      BY := (TY - 6) * 2;
      AutotileTable := @WALL_AUTOTILE_TABLE;
      TableMax := High(WALL_AUTOTILE_TABLE)
    end
    else if IsTileA4(TileId) then begin
      SetNumber := 3;
      BX := TX * 2;
      if TY mod 2 = 1 then begin
        BY := Math.Floor((TY - 10) * 2.5 + 0.5);
        AutotileTable := @WALL_AUTOTILE_TABLE;
        TableMax := High(WALL_AUTOTILE_TABLE)
      end
      else
        BY := Math.Floor((TY - 10) * 2.5);
    end;

     if (Shape <= TableMax) and TilesetGraphics.HasSet(SetNumber) then
       DrawByTileDescription(AutotileTable^[Shape]);
  end;

  procedure DrawNormalTile(TileId, OffsetX, OffsetY: Integer); inline;
  var
    SetNumber, SourceLeft, SourceTop: Integer;
  begin
    if IsTileA5(TileId) then
      SetNumber := Integer(tgstA5)
    else
      SetNumber := Integer(tgstB) + (TileId div 256);

    //TODO: allow different tile widths
    SourceLeft := ((TileId div 128) mod 2 * 8 + TileId mod 8) * 48;
    SourceTop := ((TileId mod 256 div 8) mod 16) * 48;

    ResImg.CanvasBGRA.CopyRect(
      Rect(OffsetX, OffsetY, OffsetX + ADstTileWidth, OffsetY + ADstTileHeight),
      TilesetGraphics.Bitmaps[SetNumber],
      Rect(SourceLeft, SourceTop, SourceLeft + 48, SourceTop + 48)
    );
  end;

  procedure DrawTile(TileId, OffsetX, OffsetY: Integer); inline;
  begin
    if IsVisibleTile(TileId) then begin
      if IsAutotile(TileId) then
        DrawAutotile(TileId, OffsetX, OffsetY)
      else
        DrawNormalTile(TileId, OffsetX, OffsetY);
    end;
  end;

  procedure PaintCellTiles(TileX, TileY, OffsetX, OffsetY: Integer);
  var
    TileId0, TileId1, TileId2, TileId3, ShadowBits, UpperTileId1: Integer;

    procedure DrawList(Tiles: TIntegerList); inline;
    var
      TileId: Integer;
    begin
      for TileId in Tiles do begin
        if TileId < 0 then
          DrawShadow(ShadowBits, OffsetX, OffsetY)
        else if TileId >= TABLE_EDGE_VIRTUAL_ID then
          DrawTableEdge(UpperTileId1, OffsetX, OffsetY)
        else
          DrawTile(TileId, OffsetX, OffsetY)
      end;
    end;

  begin
    TileId0 := ReadMapData(TileX, TileY, 0);
    TileId1 := ReadMapData(TileX, TileY, 1);
    TileId2 := ReadMapData(TileX, TileY, 2);
    TileId3 := ReadMapData(TileX, TileY, 3);
    ShadowBits := ReadMapData(TileX, TileY, 4);
    UpperTileId1 := ReadMapData(TileX, TileY - 1, 1);
    UpperTiles.Clear;
    LowerTiles.Clear;

    AddTileToList(TileId0);
    AddTileToList(TileId1);

    LowerTiles.Add(-ShadowBits);

    if IsTableTile(UpperTileId1) and not IsTableTile(TileId1) then
      if not IsShadowingTile(TileId0) then
        LowerTiles.Add(TABLE_EDGE_VIRTUAL_ID + UpperTileId1);

    //Overpass position?
    AddTileToList(TileId2);
    AddTileToList(TileId3);

    DrawList(LowerTiles);
    DrawList(UpperTiles);
  end;

var
  X, Y: Integer;
  TilesetId: Integer;
begin
  if Map = nil then begin
    DrawMap := nil;
    Exit;
  end;

  MapWidth := Map.Integers['width'];
  MapHeight := Map.Integers['height'];
  TilesetId := Map.Integers['tilesetId'];
  Flags := Db.Tilesets.Objects[TilesetId].Arrays['flags'];
  Data := Map.Arrays['data'];
  X1 := TilesRect.Left;
  Y1 := TilesRect.Top;
  X2 := TilesRect.Right;
  Y2 := TilesRect.Bottom;
  TileWidth := ADstTileWidth;
  TileHeight := ADstTileHeight;
  if X1 > MapWidth - 1 then
    X1 := MapWidth - 1;
  if X2 > MapWidth - 1 then
    X2 := MapWidth - 1;
  if Y1 > MapHeight - 1 then
    Y1 := MapHeight - 1;
  if Y2 > MapHeight - 1 then
    Y2 := MapHeight - 1;

  UpperTiles := TIntegerList.Create;
  LowerTiles := TIntegerList.Create;

  ResImg := TBGRABitmap.Create(
    (X2 - X1 + 1) * TileWidth,
    (Y2 - Y1 + 1) * TileHeight,
    ColorToBGRA(ColorToRGB(clRed))
  );
  ResImg.CanvasBGRA.AntialiasingMode := amOff;
  for X := X1 to X2 do
    for Y := Y1 to Y2 do begin
      UpperTiles.Clear;
      LowerTiles.Clear;
      PaintCellTiles(X, Y, (X - X1) * TileWidth, (Y - Y1) * TileHeight);
    end;

  UpperTiles.Free;
  LowerTiles.Free;

  DrawMap := ResImg;
end;

end.

